home *** CD-ROM | disk | FTP | other *** search
Text File | 2000-03-26 | 24.1 KB | 744 lines | [TEXT/R*ch] |
- % Copyright (C) 1990, 1996, 1997, 1998, 1999 Aladdin Enterprises. All rights reserved.
- %
- % This file is part of Aladdin Ghostscript.
- %
- % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND. No author
- % or distributor accepts any responsibility for the consequences of using it,
- % or for whether it serves any particular purpose or works at all, unless he
- % or she says so in writing. Refer to the Aladdin Ghostscript Free Public
- % License (the "License") for full details.
- %
- % Every copy of Aladdin Ghostscript must include a copy of the License,
- % normally in a plain ASCII text file named PUBLIC. The License grants you
- % the right to copy, modify and redistribute Aladdin Ghostscript, but only
- % under certain conditions described in the License. Among other things, the
- % License requires that the copyright notice and this notice be preserved on
- % all copies.
-
- % $Id: gs_lev2.ps,v 1.1 2000/03/09 08:40:40 lpd Exp $
- % Initialization file for Level 2 functions.
- % When this is run, systemdict is still writable,
- % but (almost) everything defined here goes into level2dict.
-
- level2dict begin
-
- % ------ System and user parameters ------ %
-
- % User parameters must obey save/restore, and must also be maintained
- % per-context. We implement the former, and some of the latter, here
- % with PostScript code. NOTE: our implementation assumes that user
- % parameters change only as a result of setuserparams -- that there are
- % no user parameters that are ever changed dynamically by the interpreter
- % (although the interpreter may adjust the value presented to setuserparams)
- %
- % There are two types of user parameters: those which are actually
- % maintained in the interpreter, and those which exist only at the
- % PostScript level. We maintain the current state of both types in
- % a read-only local dictionary named userparams, defined in systemdict.
- % In a multi-context system, each context has its own copy of this
- % dictionary. In addition, there is a constant dictionary named
- % psuserparams whose keys are the names of user parameters that exist
- % only in PostScript and whose values are (currently) arbitrary values
- % of the correct datatype: setuserparams uses this for type checking.
- % setuserparams updates userparams explicitly, in addition to setting
- % any user parameters in the interpreter; thus we can use userparams
- % to reset those parameters after a restore or a context switch.
- % NOTE: the name userparams is known to the interpreter, and in fact
- % the interpreter creates the userparams dictionary.
-
- % Check parameters that are managed at the PostScript level.
- % Currently we allow resetting them iff the new value is of the same type.
- /.checksetparams { % <newdict> <opname> <checkdict>
- % .checksetparams <newdict>
- 2 index {
- % Stack: newdict opname checkdict key newvalue
- 3 copy pop .knownget
- { type 1 index type ne
- { pop pop pop load /typecheck signalerror }
- if
- dup type /stringtype eq
- { dup rcheck not
- { pop pop pop load /invalidaccess signalerror }
- if
- }
- if
- }
- if pop pop
- } forall pop pop
- } .bind def % not odef, shouldn't reset stacks
-
- % currentuser/systemparams creates and returns a dictionary in the
- % current VM. The easiest way to make this work is to copy any composite
- % PostScript-level parameters to global VM. Currently, the only such
- % parameters are strings. In fact, we always copy string parameters,
- % so that we can be sure the contents won't be changed.
- /.copyparam { % <value> .copyparam <value'>
- dup type /stringtype eq {
- .currentglobal true .setglobal
- 1 index length string exch .setglobal
- copy readonly
- } if
- } .bind def
-
- % Some user parameters are managed entirely at the PostScript level.
- % We take care of that here.
- systemdict begin
- /psuserparams 40 dict def
- /getuserparam { % <name> getuserparam <value>
- /userparams .systemvar 1 index get exch pop
- } odef
- % Fill in userparams (created by the interpreter) with current values.
- mark .currentuserparams
- counttomark 2 idiv {
- userparams 3 1 roll put
- } repeat pop
- /.definepsuserparam { % <name> <value> .definepsuserparam -
- psuserparams 3 copy pop put
- userparams 3 1 roll put
- } .bind def
- end
- /currentuserparams { % - currentuserparams <dict>
- /userparams .systemvar dup length dict .copydict
- } odef
- /setuserparams { % <dict> setuserparams -
- % Check that we will be able to set the PostScript-level
- % user parameters.
- /setuserparams /psuserparams .systemvar .checksetparams
- % Set the C-level user params. If this succeeds, we know that
- % the password check succeeded.
- dup .setuserparams
- % Now set the PostScript-level params.
- % The interpreter may have adjusted the values of some of the
- % parameters, so we have to read them back.
- dup {
- /userparams .systemvar 2 index known {
- psuserparams 2 index known not {
- pop dup .getuserparam
- } if
- .copyparam
- /userparams .systemvar 3 1 roll .forceput % userparams is read-only
- } {
- pop pop
- } ifelse
- } forall
- % A context switch might have occurred during the above loop,
- % causing the interpreter-level parameters to be reset.
- % Set them again to the new values. From here on, we are safe,
- % since a context switch will consult userparams.
- .setuserparams
- } .bind odef
- % Initialize user parameters managed here.
- /JobName () .definepsuserparam
-
- % Restore must restore the user parameters.
- % (Since userparams is in local VM, save takes care of saving them.)
- /restore { % <save> restore -
- //restore /userparams .systemvar .setuserparams
- } .bind odef
-
- % The pssystemparams dictionary holds some system parameters that
- % are managed entirely at the PostScript level.
- systemdict begin
- currentdict /pssystemparams known not {
- /pssystemparams 40 dict readonly def
- } if
- /getsystemparam { % <name> getsystemparam <value>
- //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
- } odef
- end
- /currentsystemparams { % - currentsystemparams <dict>
- mark .currentsystemparams //pssystemparams { } forall .dicttomark
- } odef
- /setsystemparams { % <dict> setsystemparams -
- % Check that we will be able to set the PostScript-level
- % system parameters.
- /setsystemparams //pssystemparams .checksetparams
- % Set the C-level system params. If this succeeds, we know that
- % the password check succeeded.
- dup .setsystemparams
- % Now set the PostScript-level params. We must copy local strings
- % into global VM.
- dup
- { //pssystemparams 2 index known
- { % Stack: key newvalue
- .copyparam
- //pssystemparams 3 1 roll .forceput % pssystemparams is read-only
- }
- { pop pop
- }
- ifelse
- }
- forall pop
- } .bind odef
-
- % Initialize the passwords.
- % NOTE: the names StartJobPassword and SystemParamsPassword are known to
- % the interpreter, and must be bound to noaccess strings.
- % The length of these strings must be max_password (iutil2.h) + 1.
- /StartJobPassword 65 string noaccess def
- /SystemParamsPassword 65 string noaccess def
-
- % Redefine cache parameter setting to interact properly with userparams.
- /setcachelimit {
- mark /MaxFontItem 2 index .dicttomark setuserparams pop
- } .bind odef
- /setcacheparams {
- % The MaxFontCache parameter is a system parameter, which we might
- % not be able to set. Fortunately, this doesn't matter, because
- % system parameters don't have to be synchronized between this code
- % and the VM.
- counttomark 1 add copy setcacheparams
- currentcacheparams % mark size lower upper
- 3 -1 roll pop
- /MinFontCompress 3 1 roll
- /MaxFontItem exch
- .dicttomark setuserparams
- cleartomark
- } .bind odef
-
- % Add bogus user and system parameters to satisfy badly written PostScript
- % programs that incorrectly assume the existence of all the parameters
- % listed in Appendix C of the Red Book. Note that some of these may become
- % real parameters later: code near the end of gs_init.ps takes care of
- % removing any such parameters from ps{user,system}params.
-
- psuserparams begin
- /MaxFormItem 100000 def
- /MaxPatternItem 20000 def
- /MaxScreenItem 48000 def
- /MaxUPathItem 5000 def
- end
-
- pssystemparams begin
- /CurDisplayList 0 .forcedef
- /CurFormCache 0 .forcedef
- /CurOutlineCache 0 .forcedef
- /CurPatternCache 0 .forcedef
- /CurUPathCache 0 .forcedef
- /CurScreenStorage 0 .forcedef
- /CurSourceList 0 .forcedef
- /DoPrintErrors false .forcedef
- /MaxDisplayList 140000 .forcedef
- /MaxFormCache 100000 .forcedef
- /MaxOutlineCache 65000 .forcedef
- /MaxPatternCache 100000 .forcedef
- /MaxUPathCache 300000 .forcedef
- /MaxScreenStorage 84000 .forcedef
- /MaxSourceList 25000 .forcedef
- /RamSize 4194304 .forcedef
- end
-
- % ------ Miscellaneous ------ %
-
- (<<) cvn % - << -mark-
- /mark load def
- (>>) cvn % -mark- <key1> <value1> ... >> <dict>
- /.dicttomark load def
- /languagelevel 2 def
- % When running in Level 2 mode, this interpreter is supposed to be
- % compatible with Adobe version 2017.
- /version (2017) readonly def
-
- % If binary tokens are supported by this interpreter,
- % set an appropriate default binary object format.
- /setobjectformat where
- { pop
- /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
- /ByteOrder getsystemparam { 1 add } if
- setobjectformat
- } if
-
- % Aldus Freehand versions 2.x check for the presence of the
- % setcolor operator, and if it is missing, substitute a procedure.
- % Unfortunately, the procedure takes different parameters from
- % the operator. As a result, files produced by this application
- % cause an error if the setcolor operator is actually defined
- % and 'bind' is ever used. Aldus fixed this bug in Freehand 3.0,
- % but there are a lot of files created by the older versions
- % still floating around. Therefore, at Adobe's suggestion,
- % we implement the following dreadful hack in the 'where' operator:
- % If the key is /setcolor, and
- % there is a dictionary named FreeHandDict, and
- % currentdict is that dictionary,
- % then "where" consults only that dictionary and not any other
- % dictionaries on the dictionary stack.
- .wheredict /setcolor {
- /FreeHandDict .where {
- /FreeHandDict get currentdict eq {
- pop currentdict /setcolor known { currentdict true } { false } ifelse
- } {
- .where
- } ifelse
- } {
- .where
- } ifelse
- } bind put
-
- % ------ Virtual memory ------ %
-
- /currentglobal % - currentglobal <bool>
- /currentshared load def
- /gcheck % <obj> gcheck <bool>
- /scheck load def
- /setglobal % <bool> setglobal -
- /setshared load def
- % We can make the global dictionaries very small, because they auto-expand.
- /globaldict currentdict /shareddict .knownget not { 4 dict } if def
- /GlobalFontDirectory SharedFontDirectory def
-
- % VMReclaim and VMThreshold are user parameters.
- /setvmthreshold { % <int> setvmthreshold -
- mark /VMThreshold 2 index .dicttomark setuserparams pop
- } odef
- /vmreclaim { % <int> vmreclaim -
- dup 0 gt {
- .vmreclaim
- } {
- mark /VMReclaim 2 index .dicttomark setuserparams pop
- } ifelse
- } odef
- -1 setvmthreshold
-
- % ------ IODevices ------ %
-
- /.getdevparams where {
- pop /currentdevparams { % <iodevice> currentdevparams <dict>
- .getdevparams .dicttomark
- } odef
- } if
- /.putdevparams where {
- pop /setdevparams { % <iodevice> <dict> setdevparams -
- mark 1 index { } forall counttomark 2 add index
- .putdevparams pop pop
- } odef
- } if
-
- % ------ Job control ------ %
-
- serverdict begin
-
- % We could protect the job information better, but we aren't attempting
- % (currently) to protect ourselves against maliciousness.
-
- /.jobsave null def % top-level save object
- /.jobsavelevel 0 def % save depth of job (0 if .jobsave is null,
- % 1 otherwise)
- /.adminjob true def % status of current unencapsulated job
-
- end % serverdict
-
- % Because there may be objects on the e-stack created since the job save,
- % we have to clear the e-stack before doing the end-of-job restore.
- % We do this by executing a 2 .stop, which is caught by the 2 .stopped
- % in .runexec; we leave on the o-stack a procedure to execute aftewards.
- %
- %**************** The definition of startjob is not complete yet, since
- % it doesn't reset stdin/stdout.
- /.startnewjob { % <exit_bool> <password_level>
- % .startnewjob -
- serverdict /.jobsave get dup null eq { pop } { restore } ifelse
- exch {
- % Unencapsulated job
- serverdict /.jobsave null put
- serverdict /.jobsavelevel 0 put
- serverdict /.adminjob 3 -1 roll 1 gt put
- % The Adobe documentation doesn't say what happens to the
- % graphics state stack in this case, but an experiment
- % produced results suggesting that a grestoreall occurs.
- grestoreall
- } {
- % Encapsulated job
- pop
- serverdict /.jobsave save put
- serverdict /.jobsavelevel 1 put
- } ifelse
- % Reset the interpreter state.
- clear cleardictstack
- initgraphics
- false setglobal
- } bind def
- /.startjob { % <exit_bool> <password> <finish_proc>
- % .startjob <ok_bool>
- vmstatus pop pop serverdict /.jobsavelevel get eq
- 2 index .checkpassword 0 gt and {
- exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
- cleardictstack
- % Reset the e-stack back to the 2 .stopped in .runexec,
- % passing the finish_proc to be executed afterwards.
- 2 .stop
- } { % Password check failed
- pop pop pop false
- } ifelse
- } odef
- /startjob { % <exit_bool> <password> startjob <ok_bool>
- % This is a hack. We really need some way to indicate explicitly
- % to the interpreter that we are under control of a job server.
- .userdict /quit /stop load put
- { .startnewjob true } .startjob
- } odef
-
- systemdict begin
- /quit { % - quit -
- //systemdict begin serverdict /.jobsave get null eq
- { end //quit }
- { /quit load /invalidaccess /signalerror load end exec }
- ifelse
- } bind odef
- end
-
- % We would like to define exitserver as a procedure, using the code
- % that the Red Book says is equivalent to it. However, since startjob
- % resets the exec stack, we can't do this, because control would never
- % proceed past the call on startjob if the exitserver is successful.
- % Instead, we need to construct exitserver out of pieces of startjob.
-
- serverdict begin
-
- /exitserver { % <password> exitserver -
- true exch { .startnewjob } .startjob not {
- /exitserver /invalidaccess signalerror
- } if
- } bind def
-
- end % serverdict
-
- % ------ Compatibility ------ %
-
- % In Level 2 mode, the following replace the definitions that gs_statd.ps
- % installs in statusdict and serverdict.
- % Note that statusdict must be allocated in local VM.
- % We don't bother with many of these yet.
-
- /.dict1 { exch mark 3 1 roll .dicttomark } bind def
-
- currentglobal false setglobal 25 dict exch setglobal begin
- currentsystemparams
-
- % The following do not depend on the presence of setpagedevice.
- /buildtime 1 index /BuildTime get def
- /byteorder 1 index /ByteOrder get def
- /checkpassword { .checkpassword 0 gt } bind def
- dup /DoStartPage known
- { /dostartpage { /DoStartPage getsystemparam } bind def
- /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
- } if
- dup /StartupMode known
- { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
- /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
- } if
- %****** Setting jobname is supposed to set userparams.JobName, too.
- /jobname { /JobName getuserparam } bind def
- /jobtimeout { /JobTimeout getuserparam } bind def
- /ramsize { /RamSize getsystemparam } bind def
- /realformat 1 index /RealFormat get def
- dup /PrinterName known
- { /setprintername { /PrinterName .dict1 setsystemparams } bind def
- } if
- /printername
- { currentsystemparams /PrinterName .knownget not { () } if exch copy
- } bind def
- currentuserparams /WaitTimeout known
- { /waittimeout { /WaitTimeout getuserparam } bind def
- } if
-
- % The following do require setpagedevice.
- /.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse
- /defaulttimeouts
- { currentsystemparams dup
- /JobTimeout .knownget not { 0 } if
- exch /WaitTimeout .knownget not { 0 } if
- currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
- } bind def
- /margins
- { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
- } bind def
- /pagemargin
- { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
- } bind def
- /pageparams
- { currentpagedevice
- dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
- dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
- /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
- } bind def
- /setdefaulttimeouts
- { exch mark /ManualFeedTimeout 3 -1 roll
- /Policies mark /ManualFeedTimeout 1 .dicttomark
- .dicttomark setpagedevice
- /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
- } bind def
- /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
- /setduplexmode { /Duplex .dict1 setpagedevice } bind def
- /setmargins
- { exch 2 array astore /Margins .dict1 setpagedevice
- } bind def
- /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
- /setpageparams
- { mark /PageSize 6 -2 roll
- 4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
- /Orientation 5 -1 roll ORIENT1 { 1 xor } if
- /PageOffset counttomark 2 add -1 roll 0 2 array astore
- .dicttomark setpagedevice
- } bind def
- /setresolution
- { dup 2 array astore /HWResolution .dict1 setpagedevice
- } bind def
- %END PAGEDEVICE
-
- % The following are not implemented yet.
- %manualfeed
- %manualfeedtimeout
- %pagecount
- %pagestackorder
- %setpagestackorder
-
- pop % currentsystemparams
-
- % Flag the current dictionary so it will be swapped when we
- % change language levels. (See zmisc2.c for more information.)
- /statusdict currentdict def
-
- currentdict end
- /statusdict exch .forcedef % statusdict is local, systemdict is global
-
- % ------ Color spaces ------ %
-
- % Define the setcolorspace procedures:
- % <colorspace> proc <colorspace'|null>
- /colorspacedict mark
- /DeviceGray { pop 0 setgray null } bind
- /DeviceRGB { pop 0 0 0 setrgbcolor null } bind
- /setcmykcolor where
- { pop /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind
- } if
- /.setcieaspace where
- { pop /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind
- } if
- /.setcieabcspace where
- { pop /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind
- } if
- /.setciedefspace where
- { pop /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind
- } if
- /.setciedefgspace where
- { pop /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind
- } if
- /.setseparationspace where
- { pop /Separation { dup 2 get setcolorspace dup .setseparationspace } bind
- } if
- /.setindexedspace where
- { pop /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind
- } if
- /.nullpatternspace [/Pattern] readonly def
- /.setpatternspace where
- { pop /Pattern
- { dup type /nametype eq { pop //.nullpatternspace } if
- dup length 1 gt { dup 1 get setcolorspace } if
- dup .setpatternspace
- } bind
- } if
- % If DeviceN space is included, gs_ll3.ps registers it.
- /.setdevicepixelspace where
- { pop /DevicePixel { dup .setdevicepixelspace } bind
- } if
- currentdict /.nullpatternspace .undef
- .dicttomark def
-
- /.devcs [
- /DeviceGray /DeviceRGB /DeviceCMYK /DevicePixel
- ] readonly def
- /currentcolorspace { % - currentcolorspace <array>
- .currentcolorspace dup type /integertype eq {
- //.devcs exch 1 getinterval
- } if
- } odef
- currentdict /.devcs .undef
-
- /setcolorspace { % <name|array> setcolorspace -
- dup dup dup type /nametype ne { 0 get } if
- //colorspacedict exch get exec
- dup null eq { pop } { .setcolorspace } ifelse pop
- } odef
-
- % ------ CIE color rendering ------ %
-
- % Define findcolorrendering and a default ColorRendering ProcSet.
-
- /findcolorrendering { % <intentname> findcolorrendering
- % <crdname> <found>
- /ColorRendering /ProcSet findresource
- 1 index .namestring (.) concatstrings
- 1 index /GetPageDeviceName get exec .namestring (.) concatstrings
- 2 index /GetHalftoneName get exec .namestring
- concatstrings concatstrings
- dup /ColorRendering resourcestatus {
- pop pop exch pop exch pop true
- } {
- pop /GetSubstituteCRD get exec false
- } ifelse
- } odef
-
- 5 dict dup begin
-
- /GetPageDeviceName { % - GetPageDeviceName <name>
- currentpagedevice dup /PageDeviceName .knownget {
- exch pop dup null eq { pop /none } if
- } {
- pop /none
- } ifelse
- } bind def
-
- /GetHalftoneName { % - GetHalftoneName <name>
- currenthalftone /HalftoneName .knownget not { /none } if
- } bind def
-
- /GetSubstituteCRD { % <intentname> GetSubstituteCRD <crdname>
- pop /DefaultColorRendering
- } bind def
-
- end
- % The resource machinery hasn't been activated, so just save the ProcSet
- % and let .fixresources finish the installation process.
- /ColorRendering exch def
-
- % Define setcolorrendering.
-
- /.colorrenderingtypes 5 dict def
-
- /setcolorrendering { % <crd> setcolorrendering -
- dup /ColorRenderingType get //.colorrenderingtypes exch get exec
- } odef
-
- /.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse
-
- .colorrenderingtypes 1 {
- dup .buildcolorrendering1 .setcolorrendering1
- } .bind put
-
- % Note: the value 101 in the next line must be the same as the value of
- % GX_DEVICE_CRD1_TYPE in gscrdp.h.
- .colorrenderingtypes 101 {
- dup .builddevicecolorrendering1 .setdevicecolorrendering1
- } .bind put
-
- % Initialize the default CIE rendering dictionary.
- % The most common CIE files seem to assume the "calibrated RGB color space"
- % described on p. 189 of the PostScript Language Reference Manual,
- % 2nd Edition; we simply invert this transformation back to RGB.
- mark
- /ColorRenderingType 1
- % We must make RangePQR and RangeLMN large enough so that values computed by
- % the assumed encoding MatrixLMN don't get clamped.
- /RangePQR [0 0.9505 0 1 0 1.0890] readonly
- /TransformPQR
- [ {exch pop exch pop exch pop exch pop} bind dup dup ] readonly
- /RangeLMN [0 0.9505 0 1 0 1.0890] readonly
- /MatrixABC
- [ 3.24063 -0.96893 0.05571
- -1.53721 1.87576 -0.20402
- -0.49863 0.04152 1.05700
- ] readonly
- /EncodeABC [ {0 .max 0.45 exp} bind dup dup] readonly
- /WhitePoint [0.9505 1 1.0890] readonly
- % Some Genoa tests seem to require the presence of BlackPoint.
- /BlackPoint [0 0 0] readonly
- .dicttomark setcolorrendering
-
- %END CRD
-
- % Initialize a CIEBased color space for sRGB.
- /CIEsRGB [ /CIEBasedABC
- mark
- /DecodeLMN [ {
- dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
- } bind dup dup ] readonly
- /MatrixLMN [
- 0.412457 0.212673 0.019334
- 0.357576 0.715152 0.119192
- 0.180437 0.072175 0.950301
- ] readonly
- /WhitePoint [0.9505 1.0 1.0890] readonly
- .dicttomark readonly
- ] readonly def
-
- % ------ Painting ------ %
-
- % A straightforward definition of execform that doesn't actually
- % do any caching.
- /.execform1 {
- % This is a separate operator so that the stacks will be restored
- % properly if an error occurs.
- dup /Matrix get concat
- dup /BBox get aload pop
- exch 3 index sub exch 2 index sub rectclip
- dup /PaintProc get
- 1 index /Implementation known not {
- 1 index dup /Implementation null .forceput readonly pop
- } if
- exec
- } .bind odef % must bind .forceput
-
- /.formtypes 5 dict
- dup 1 /.execform1 load put
- def
-
- /execform { % <form> execform -
- gsave {
- dup /FormType get //.formtypes exch get exec
- } stopped grestore { stop } if
- } odef
-
- /.patterntypes 5 dict
- dup 1 /.buildpattern1 load put
- def
-
- /makepattern { % <proto_dict> <matrix> makepattern <pattern>
- //.patterntypes 2 index /PatternType get get
- .currentglobal false .setglobal exch
- % Stack: proto matrix global buildproc
- 3 index dup length 1 add dict .copydict
- 3 index 3 -1 roll exec 3 -1 roll .setglobal
- 1 index /Implementation 3 -1 roll put
- readonly exch pop exch pop
- } odef
-
- /setpattern { % [<comp1> ...] <pattern> setpattern -
- currentcolorspace 0 get /Pattern ne {
- [ /Pattern currentcolorspace ] setcolorspace
- } if setcolor
- } odef
-
- % Extend image and imagemask to accept dictionaries.
- % We must create .imagetypes and .imagemasktypes outside level2dict,
- % and leave some extra space because we're still in Level 1 mode.
- systemdict begin
- /.imagetypes 5 dict
- dup 1 /.image1 load put
- def
- /.imagemasktypes 5 dict
- dup 1 /.imagemask1 load put
- def
- end
-
- /.image /image load def
- /image {
- dup type /dicttype eq {
- dup /ImageType get //.imagetypes exch get exec
- } {
- //.image
- } ifelse
- } odef
- currentdict /.image undef
-
- /.imagemask /imagemask load def
- /imagemask {
- dup type /dicttype eq {
- dup /ImageType get //.imagemasktypes exch get exec
- } {
- //.imagemask
- } ifelse
- } odef
- currentdict /.imagemask undef
-
- end % level2dict
-